LL1P30: PROC;
/****************************************************************
*               LL(1) GRAMMAR ANALYZER - PHASE 3		*
*PURPOSE:                                                       *
*    THIS PROGRAM ANALYZES A LL(1) GRAMMAR GIVEN IN MODIFIED    *
*    BNF FORMAT AND FINDS THE NULLABLE NON-TERMINALS AND NUL-   *
*    LABLE PRODUCTIONS.                                         *
*INPUT:                                                         *
*OUTPUT:                                                        *
*OUTLINE:                                                       *
*REMARKS:                                                       *
****************************************************************/

/****************************************************************
* * * * * * * * * * * COMMON DATA DEFINITIONS * * * * * * * * * *
****************************************************************/

/*	* * *  COMMON REPLACEMENTS  * * *	*/
%REPLACE TRUE BY '1'B;
%REPLACE FALSE BY '0'B;

%INCLUDE 'LL1CMN.DCL';	/* GET COMMON AREAS. */


/****************************************************************
* * * * * * * * * * * COMMON PROCUDURES * * * * * * * * * * * * *
****************************************************************/


%INCLUDE 'LL1PRC.DCL';


COMPUTE_ALIVE: PROC (PRDSET_NUM,PRDSET_PTR) RETURNS(CHAR(254) VARYING);
/* THIS ROUTINE COMPUTES THE SET OF ALIVE NON-TERMINALS. */
/* A NONTERMINAL IS ALIVE IF IT CAN DERIVE ONE OR MORE
   TERMINAL STRINGS; OTHERWISE, IT IS DEAD. */

	DCL PRDSET_NUM BIN(15); /* NUMBER OF PRODUCTIONS IN SET */
	DCL PRDSET_PTR PTR;	/* PTR TO PRODUCTION SET */
	DCL PRDSET(MAX_PROD) BIN(15) BASED(PRDSET_PTR);
	DCL ALIVE_SET CHAR(254) VARYING;
	DCL ALIVE_FLAG BIT(1);	/* FLAG USED DURING CHECKING */
	DCL ALIVE_LOOP BIT(1); /* FLAG USED TO CONTROL LOOPING */
	DCL I FIXED;		/* INTERNAL INDEX */
	DCL J FIXED;		/* INTERNAL INDEX */

/* DETERMINE ALL NONTERMINALS WHICH APPEAR ON THE LEFT-HAND
   SIDE OF AT LEAST ONE PRODUCTION WHICH HAS NO NON-TERMINALS
   ON THE RIGHT-HAND SIDE. */
	ALIVE_SET='';
	DO I=1 TO PRDSET_NUM;
	   IF LENGTH(RHS(PRDSET(I)))=0 THEN
	      ALIVE_FLAG=TRUE;
	   ELSE
	      DO;
	         ALIVE_FLAG=TRUE;
	         DO J=1 TO LENGTH(RHS(PRDSET(I)));
	            IF ISNTRM(SUBSTR(RHS(PRDSET(I)),J,1)) THEN
		       DO;
	                  ALIVE_FLAG=FALSE;
			  J=LENGTH(RHS(PRDSET(I)));
		       END;
	         END;
	      END;
	   IF ALIVE_FLAG THEN
	      DO;
		 IF LENGTH(ALIVE_SET)=0 THEN /*INSURE NO DUPLICATES*/
		    ;
		 ELSE
		    DO J=1 TO LENGTH(ALIVE_SET);
		       IF LHS(PRDSET(I))=SUBSTR(ALIVE_SET,J,1) THEN
			  DO;
			     ALIVE_FLAG=FALSE;
			     J=LENGTH(ALIVE_SET);
			  END;
		    END;
		 IF ALIVE_FLAG THEN
	            ALIVE_SET=ALIVE_SET||LHS(PRDSET(I));
	      END;
	END; /* DO */

/* ALSO, DETERMINE ALL NON-TERMINALS WHICH APPEAR ON THE 
   LEFT-HAND SIDE OF AT LEAST ONE PRODUCTION FOR WHICH ALL
   NON-TERMINALS ON THE RIGHT-HAND SIDE ALREADY ARE ALIVE.
	ALIVE_LOOP=TRUE;	/* SET FOR FIRST TIME. */
	DO WHILE(ALIVE_LOOP);   /* LOOP AS LONG AS WE FOUND
				   AN ALIVE NON-TERMINAL ON
				   THE LAST PASS. */
	   ALIVE_LOOP=FALSE;	/* DEFAULT TO NOT FOUND ONE */
	   DO I=1 TO PRDSET_NUM;
	      ALIVE_FLAG=TRUE;
	      IF LENGTH(RHS(PRDSET(I)))~=0 THEN
	         DO J=1 TO LENGTH(RHS(PRDSET(I)));
	            IF IS_ALIVE(SUBSTR(RHS(PRDSET(I)),J,1),
				ALIVE_SET)=FALSE THEN
	               ALIVE_FLAG=FALSE;
	         END;
	      IF ALIVE_FLAG=TRUE THEN
	         DO;
		    IF LENGTH(ALIVE_SET)=0 THEN
		       DO;
		       END;
		    ELSE
		       DO J=1 TO LENGTH(ALIVE_SET); /*INSURE NO DUPLICATES*/
			  IF LHS(PRDSET(I))=SUBSTR(ALIVE_SET,J,1) THEN
			     DO;
			        ALIVE_FLAG=FALSE;
			        J=LENGTH(ALIVE_SET);
			     END;
		       END;
		    IF ALIVE_FLAG=TRUE THEN
		       DO;
	                  ALIVE_SET=ALIVE_SET||LHS(PRDSET(I));
	                  ALIVE_LOOP=TRUE; /* INDICATE WE FOUND ONE. */
		       END;
	         END;
	   END;
	END; /* WHILE */

/* RETURN TO CALLER. */
	RETURN(ALIVE_SET);
	END COMPUTE_ALIVE;
	

IS_ALIVE: PROC (X,SET) RETURNS(BIT(1));
/* THIS ROUTINE INDICATES IF A NON-TERMINAL IS ALIVE. */
	DCL X CHAR;		/* INPUT INDEX */
	DCL SET CHAR(254) VARYING; /* SET OF ALIVE NON-TERMINALS */
	DCL I FIXED;		/* INTERNAL INDEX */

	IF LENGTH(SET)=0 THEN
	   RETURN(FALSE);

	DO I=1 TO LENGTH(SET);
	   IF X=SUBSTR(SET,I,1) THEN
	      RETURN(TRUE);
	END;

	RETURN(FALSE);
	END IS_ALIVE;
	

PRINT_NPRD: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE NULLABLE */
/*PRODUCTIONS. */
	DCL I BIN(15);		/* INDEXES */
	DCL J BIN(15);
	DCL LHS_ENT CHAR(10) VARYING;
	DCL RHS_ENT(5) CHAR(10) VARYING;

/* OUTPUT THE HEADING. */
	ON ENDPAGE(LSTFIL)
	   BEGIN;
	      PUT FILE(LSTFIL) PAGE;
	      PUT FILE(LSTFIL) SKIP(3) 
		  EDIT('*** NULLABLE PRODUCTION LISTING ***','PAGE',
			PAGENO(LSTFIL)-1)
		  (X(15),A(35),X(10),A(4),F(4));
	      PUT FILE(LSTFIL) SKIP(1);
	   END;
	SIGNAL ENDPAGE(LSTFIL);

/* PRINT THE REPORT LINES. */
	DO I=1 TO NNLPRD;
	   LHS_ENT=VOC(CHRNUM(LHS(NULPRD(I))));
	   DO J=1 TO 5;
	      IF J>LENGTH(RHS(NULPRD(I))) THEN
	         RHS_ENT(J)='';
	      ELSE
	         RHS_ENT(J)=VOC(CHRNUM(SUBSTR(RHS(NULPRD(I)),J,1)));
	   END;
	   PUT FILE(LSTFIL) SKIP(1)
	       EDIT(NULPRD(I),LHS_ENT,' -> ',(RHS_ENT(J) DO J=1 TO 5),';')
		  (F(4),X(01),A,A(04),5(A,X(01)),A(1));
	END;

        END  PRINT_NPRD;


PRINT_NNT: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR PRINTING THE NULLABLE */
/*NON-TERMINALS.*/
	DCL I BIN(15);		/* INDEXES */
	DCL J BIN(15);
	DCL LHS_ENT CHAR(10) VARYING;
	DCL RHS_ENT(5) CHAR(10) VARYING;

/* OUTPUT THE HEADING. */
	ON ENDPAGE(LSTFIL)
	   BEGIN;
	      PUT FILE(LSTFIL) PAGE;
	      PUT FILE(LSTFIL) SKIP(3) 
		  EDIT('*** NULLABLE NON-TERMINAL LISTING ***','PAGE',
			PAGENO(LSTFIL)-1)
		  (X(25),A(35),X(10),A(4),F(4));
	      PUT FILE(LSTFIL) SKIP(1);
	   END;
	SIGNAL ENDPAGE(LSTFIL);

/* PRINT THE REPORT LINES. */
	DO I=1 TO LENGTH(NLNTRM);
	   LHS_ENT=VOC(CHRNUM(SUBSTR(NLNTRM,I,1)));
	   PUT FILE(LSTFIL) SKIP(1)
	       EDIT(I,LHS_ENT)
		  (X(20),F(4),X(01),A);
	END;

        END  PRINT_NNT;


/****************************************************************
* * * * * * * * * * GRAMMAR ANALYSIS PROCEDURES * * * * * * * * *
****************************************************************/


CALC_NULPRD: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE SET OF  */
/*NULLABLE PRODUCTIONS.  THE NULLABLE PRODUCTIONS ARE     */
/*THOSE FOR WHICH THE SYMBOLS ON THE RIGTH-HAND SIDE ARE  */
/*ALL NULLABLE.  THAT IS, ALL RIGHT-HAND SIDE SYMBOLS     */
/*MUST BE NULLABLE NON-TERMINALS. */
	DCL I BIN(15);		/* INDEXES */
	DCL J BIN(15);
	DCL NNL_FND BIT(1);	/* TERMINAL FOUND INDICATOR */

/* CALCULATE PRODUCTION SET. */
	NNLPRD=0;		/* ZERO NUL PRD COUNT. */
	DO I=1 TO NUMPRD;	/* LOOP THRU ALL PRODUCTIONS. */
	   IF LENGTH(RHS(I))=0 THEN /*EPSILON PRODUCTION*/
	      DO;
	         NNL_FND=TRUE;		/*ADD PRODUCTION TO SET.*/
	      END;
	   ELSE
	      DO J=1 TO LENGTH(RHS(I));
	         NNL_FND=ISNLNT(SUBSTR(RHS(I),J,1));
	         IF NNL_FND=FALSE THEN
	            J=LENGTH(RHS(I));	/*FORCE END OF SEARCH.*/
	      END;
	   IF NNL_FND=TRUE THEN
	      DO;
	         NNLPRD=NNLPRD+1;	/*ADD PRODUCTION TO SET.*/
	         NULPRD(NNLPRD)=I;
	   END;
	END;

/* RETURN TO CALLER. */
	END CALC_NULPRD;


CALC_NULTRM: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE SET OF  */
/*NULLABLE NON-TERMINALS GIVEN THE GRAMMAR CALCULATED IN  */
/*THE PREVIOUS STEP.  THE NULLABLE NON-TERMINALS ARE THOSE*/
/*FOUND TO BE ALIVE IN THE NEW GRAMMAR. */

/* CALCULATE THE NULLABLE NON-TERMINALS. */
	NLNTRM=COMPUTE_ALIVE(NNLPRD,ADDR(NULPRD));

/* RETURN TO CALLER. */
	END CALC_NULTRM;


CALC_PRDSET: PROC;
/*THIS ROUTINE IS RESPONSIBLE FOR CALCULATING THE INITIAL */
/*SET OF POSSIBLE NULLABLE PRODUCTIONS.  TO DO THIS, IT   */
/*TAKES THE SET OF ALL PRODUCTIONS IN THE GIVEN GRAMMAR   */
/*AND DELETES ALL PRODUCTIONS WHICH CONTAIN A TERMINAL IN */
/*ITS RIGHT-HAND SIDE.  SINCE EPSILON IS NOT A TERMINAL   */
/*SYMBOL, THIS STEP DOES NOT DELETE ANY EPSILON PRODUC-	  */
/*TIONS. */
	DCL I BIN(15);		/* INDEXES */
	DCL J BIN(15);
	DCL TRM_FND BIT(1);	/* TERMINAL FOUND INDICATOR */

/* CALCULATE PRODUCTION SET. */
	NNLPRD=0;		/* ZERO NUL PRD COUNT. */
	DO I=1 TO NUMPRD;	/* LOOP THRU ALL PRODUCTIONS. */
	   IF LENGTH(RHS(I))=0 THEN /*EPSILON PRODUCTION*/
	      DO;
	         TRM_FND=FALSE;
	      END;
	   ELSE
	      DO J=1 TO LENGTH(RHS(I));
	         TRM_FND=ISTRM(SUBSTR(RHS(I),J,1));
	         IF TRM_FND=TRUE THEN
	            J=LENGTH(RHS(I));	/*FORCE END OF SEARCH.*/
	      END;
	   IF TRM_FND=FALSE THEN
	      DO;
	         NNLPRD=NNLPRD+1;	/*ADD PRODUCTION TO SET.*/
	         NULPRD(NNLPRD)=I;
	   END;
	END;

/* RETURN TO CALLER. */
	END CALC_PRDSET;


/****************************************************************
* * * * * * * * * * * MAIN LINE PROCEDURE * * * * * * * * * * * *
****************************************************************/


/* ANALYZE THE GRAMMAR. */
	PUT SKIP LIST('BEGINNING PHASE 3 PROCESSING.');
	CALL CALC_PRDSET;	/*CALCULATE INITIAL SET OF POSSIBLE
				  NULLABLE PRODUCTIONS. */
	CALL CALC_NULTRM;	/*CALCULATE NULLABLE NON-TERMINALS
				  FROM THE ABOVE SET. */
	CALL CALC_NULPRD;	/*CALCULATE THE NULLABEL PRODUCTIONS.*/

/* PRINT THE RESULTS. */
	CALL PRINT_NNT;		/*PRINT NULLABLE NON-TERMINALS.*/
	CALL PRINT_NPRD;	/*PRINT NULLABLE PRODUCTIONS.*/
	PUT SKIP LIST('PHASE 3 PROCESSING COMPLETE.');
	END LL1P30;

